home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / nosnow.arc / NOSNOW.PAS < prev   
Pascal/Delphi Source File  |  1985-11-09  |  10KB  |  218 lines
  1. program nosnow;
  2.  
  3. {======================================================================}
  4. {                                                                      }
  5. { 2 procedures to write 1 byte to the display; avoid "snow"            }
  6. { 1 procedure to build an entire screen, 500 bytes at a time; avoid    }
  7. {    "snow".                                                           }
  8. {                                                                      }
  9. { NOTE: These procedures are released to the public domain on the      }
  10. { condition that nobody tells on me. There are a lot of skiers here    }
  11. { in Salt Lake City who would get very mad at somebody who was trying  }
  12. { to eliminate snow!                                                   }
  13. {                                                                      }
  14. {======================================================================}
  15.  
  16. { By Michael Quinlan   7/1/85  }
  17.  
  18. {======================================================================}
  19. {                                                                      }
  20. { NoSnow1 is not as fast as NoSnow2, but it has these advantages:      }
  21. {                                                                      }
  22. {   1. Should work on almost any PC compatible,                        }
  23. {   2. Should work with almost any display adaptor and monitor.        }
  24. {   3. Absolutely no "snow".                                           }
  25. {                                                                      }
  26. { It works by calling the BIOS to position the cursor, then calling    }
  27. { the BIOS again to write the character.                               }
  28. {                                                                      }
  29. {======================================================================}
  30.  
  31. procedure NoSnow1(r, c : integer; ch : char; a : byte);
  32.  
  33. { r = row (1..25)
  34.   c = column (1..80)
  35.   ch = character to write
  36.   a = attribute of character }
  37.  
  38.   begin
  39.     Inline(
  40.       $8a/$76/<r/      { mov dh,r[bp]   ;get row }
  41.       $fe/$ce/         { dec dh         ;convert row to [0..24] }
  42.       $8a/$56/<c/      { mov dl,c[bp]   ;get col }
  43.       $fe/$ca/         { dec dl         ;convert col to [0..79] }
  44.       $b7/$00/         { mov bh,0       ;page }
  45.       $b4/$02/         { mov ah,2       ;set cursor position }
  46.       $cd/$10/         { int $10        ;have BIOS do the dirty work }
  47.       $b7/$00/         { mov bh,0       ;page }
  48.       $b9/>1/          { mov cx,1       ;number of copies }
  49.       $8a/$46/<ch/     { mov al,ch[bp]  ;character }
  50.       $8a/$5e/<a/      { mov bl,a[bp]   ;attribute }
  51.       $b4/$09/         { mov ah,9       ;write attr/char }
  52.       $cd/$10)         { int $10        ;have BIOS do the dirty work }
  53.   end;
  54.  
  55. {======================================================================}
  56. {                                                                      }
  57. { NoSnow2 writes a single character as fast as possible to the         }
  58. { display buffer. It seems that there is still some "snow" on the      }
  59. { left edge of the screen (it usually isn't very noticable). The code  }
  60. { only works with the color graphics adaptor in 25x80 text mode. It    }
  61. { would be simple (but useless) to change the code to work with other  }
  62. { adaptors.                                                            }
  63. {                                                                      }
  64. { NoSnow2 only works on an IBM PC or highly compatible.                }
  65. {                                                                      }
  66. {======================================================================}
  67.  
  68. procedure NoSnow2(r, c : integer; ch : char; a : byte);
  69.  
  70. { r = row (1..25)
  71.   c = column (1..80)
  72.   ch = character to write
  73.   a = attribute of character }
  74.  
  75.   begin
  76.     Inline(
  77.      $8a/$46/<r/       { mov al,r[bp]   ;get row }
  78.      $fe/$c8/          { dec al         ;convert to [0..24] }
  79.      $bb/>80/          { mov bx,80      ;# columns per row }
  80.      $f7/$e3/          { mul bx         ;calc offset into display buffer }
  81.      $03/$46/<c/       { add ax,c[bp]   ;add in column }
  82.      $48/              { dec ax         ;adjust for column in [0..79] }
  83.      $03/$c0/          { add ax,ax      ;mult by to to get buffer offset }
  84.      $8b/$f8/          { mov di,ax      ;save offset for later }
  85.      $b8/$b800/        { mov ax,$b800   ;color display base }
  86.      $1e/              { push ds        ;save seg reg }
  87.      $8e/$d8/          { mov ds,ax }
  88.      $8a/$5e/<ch/      { mov bl,ch[bp]  ;character }
  89.      $8a/$7e/<a/       { mov bh,a[bp]   ;attribute }
  90.      $ba/$03da/        { mov dx,$3da    ;color status port }
  91.      $fa/              { cli            ;don't allow interrupts }
  92. {L1:}
  93.      $ec/              { in al,dx       ;wait for partial horiz. retrace }
  94.      $a8/$01/          { test al,1 }
  95.      $75/$fb/          { jnz L1 }
  96. {L2:}
  97.      $ec/              { in al,dx       ;wait for horiz retrace }
  98.      $a8/$01/          { test al,1 }
  99.      $74/$fb/          { jz L2 }
  100. { horizontal retrace in progress. we must move very quickly here... }
  101.      $89/$1d/          { mov [di],bx    ;put char, attr in AX }
  102.      $fb/              { sti            ;now allow interrupts }
  103.      $1f);             { pop ds         ;restore seg reg }
  104.  end;
  105.  
  106. {======================================================================}
  107. {                                                                      }
  108. { Procedure ColorFlash writes an entire screen to the display buffer.  }
  109. { It waits for the vertical retrace, then moves 500 bytes (250         }
  110. { characters and attributes) at a time. It is amazingly fast and is    }
  111. { completely free of flicker and snow.                                 }
  112. {                                                                      }
  113. { ColorFlash only works on an IBM PC or highly compatible, with the    }
  114. { color graphics adaptor. As with NoSnow2, it would be easy to change  }
  115. { the code to work with other adaptors (but why? other adaptors don't  }
  116. { have the hardware bug that causes "snow" in the first place...).     }
  117. {                                                                      }
  118. { This code may leave interrupts disabled for too long. Some high      }
  119. { speed communications applications, for example, may lose characters  }
  120. { while we are waiting for the vertical retrace.                       }
  121. {                                                                      }
  122. {======================================================================}
  123.  
  124. type FlashBufferType = array [1..25] of
  125.                          array [1..80] of
  126.                            record
  127.                              c : char;
  128.                              a : byte
  129.                            end;
  130.  
  131. procedure ColorFlash(var d : FlashBufferType);
  132.   begin
  133.     inline(
  134.       $1E/                        { PUSH DS         ;save reg used }
  135.       $B8/$B800/                  { MOV AX,0B800h   ;dest. segment }
  136.       $8E/$C0/                    { MOV ES,AX }
  137.       $BF/$00/$00/                { MOV DI,0        ;dest. offset }
  138.       $8B/$76/$04/                { MOV SI,4[BP]    ;source offset }
  139.       $8E/$5e/$06/                { MOV DS,6[BP]    ;source segment }
  140.       $BA/$03DA/                  { MOV DX,03DAh    ;status register }
  141.       $FC/                        { CLD             ;go forwards }
  142.       $BB/$08/$00/                { MOV BX,8        ;8*250 = 2000 words }
  143. {LOOP:}
  144.       $B9/$FA/$00/                { MOV CX,250      ;250 words/500 bytes }
  145.       $FA/                        { CLI             ;don't allow interrupts }
  146. {WAIT1:  ;wait for any partially complete vertical retrace to finish }
  147.       $EC/                        { IN AL,DX }
  148.       $A8/$08/                    { TEST AL,08h }
  149.       $75/$FB/                    { JNZ WAIT1 }
  150. {WAIT2:  ;wait for the next vertical retrace to begin }
  151.       $EC/                        { IN AL,DX }
  152.       $A8/$08/                    { TEST AL,08h }
  153.       $74/$FB/                    { JZ WAIT2 }
  154. { vertical retrace in progress; copy part of the buffer }
  155.       $F3/$A5/                    { REP MOVSW       ;move 250 word chunk }
  156.       $FB/                        { STI             ;allow interrupts }
  157.       $4B/                        { DEC BX          ;more left to move? }
  158.       $75/$EC/                    { JNZ LOOP        ;yes -- loop back }
  159.       $1F)                        { POP DS          ;no -- done }
  160.   end;
  161.  
  162. {======================================================================}
  163. {                                                                      }
  164. { simple code to show off the above routines.                          }
  165. {                                                                      }
  166. {======================================================================}
  167.  
  168. var i, j : integer;
  169.     b    : FlashBufferType;
  170.  
  171. begin
  172.  
  173. { prepare for "ColorFlash" routine }
  174.   for i := 1 to 25 do
  175.     for j := 1 to 80 do
  176.       with b[i, j] do begin
  177.         a := $1e;
  178.         c := '?'
  179.       end;
  180.  
  181.   ClrScr;
  182.   GotoXY(1,25);
  183.   write('Ready to Begin, Press Enter...');
  184.   ReadLn;
  185.  
  186.   ClrScr;
  187.   for i := 1 to 25 do
  188.     for j := 1 to 79 do begin
  189.       GotoXY(j, i);
  190.       write('z')
  191.     end;
  192.   GotoXY(1,25);
  193.   Write('Turbo Pascal Write Done, Press Enter...');
  194.   ReadLn;
  195.  
  196.   ClrScr;
  197.   for i := 1 to 25 do
  198.     for j := 1 to 80 do
  199.       NoSnow1(i, j, 'x', $1e);
  200.   GotoXY(1,25);
  201.   write('NoSnow1 Done, Press Enter...');
  202.   ReadLn;
  203.  
  204.   ClrScr;
  205.   for i := 1 to 25 do
  206.     for j := 1 to 80 do
  207.       NoSnow2(i, j, 'a', $1e);
  208.   GotoXY(1,25);
  209.   write('NoSnow2 Done, Press Enter...');
  210.   ReadLn;
  211.  
  212. {  ClrScr;}
  213.   ColorFlash(b);
  214.   GoToXY(1,25);
  215.   write('ColorFlash Done, Press Enter...');
  216.   ReadLn
  217. end.
  218.